------------------------------------------------------- MX COBOL (mxc.lst) MX COBOL Version 3.0 - EN, Copyright (c) Vlastimil Cevela 1996, 2006 (20060528) D:\CeW\cobol\p\mx_d2.cb WHEN-COMPILED = 04/06/06 06:30:13 Registered user: 060529 Name, City, Country 0001 * Indexed file from keyboard mx_d2.cb 0002 * 0003 file-control. 0004 select IDX assign "mx_d2.dat". 0005 file section. 0006 fd IDX. 0007 1 REC-IDX. 0008 2 KEY-IDX pic 9(5). 0009 2 DAT-IDX pic x(25). 0010 working-storage section. 0011 1 INP pic x(50) value ".". 0012 * 0013 procedure division. 0014 call "ICRUN" using "del mx_d2.dat". 0015 call "ICRUN" using "del mx_d2.in0". 0016 * 0017 open output IDX. | 0006 0018 perform until INP = " " | 0011 0019 display "input = number - comma - text" 0020 accept INP 0021 if INP not = " " | 0011 0011 0022 initialize REC-IDX 0023 unstring INP delimited "," | 0007 0011 0024 into KEY-IDX DAT-IDX | 0008 0025 write REC-IDX | 0009 0026 end-if | 0007 0027 end-perform. 0028 * 0029 close IDX. | 0006 0030 call "ICRUN" using "bldind mx_d2.dat mx_d2.in0 0 30 0 5". 0031 stop run. 0032 DATA DIRECTORY: LV NAME OF ITEM ADDR TP LENG LINE REFERENCE FD IDX 0006 0017 0029 01 REC-IDX 0 GR 30 0007 0022 0025 02 KEY-IDX 0 DI 5 0008 0024 02 DAT-IDX 5 AN 25 0009 0024 01 INP 0 AN 50 0011 0018 0020 0021 0023 77 TALLY 56 BI 4 0000 77 NSTD-REELS 60 BI 2 0000 77 WHEN-COMPILED 64 AN 16 0000 ERROR LISTING: line 0003: warning 0002 level 0 (some division/section/paragraph header before FILE-CONTROL missing - never mind) line 0005: warning 0002 level 0 (some division/section/paragraph header before FILE missing - never mind) Errors: 0, warnings: 2 Turbo C Version 2.01 Copyright (c) 1987, 1988 Borland International d:\cew\cobol\p\mx_d2.c: Available memory 351462 Turbo C Version 2.01 Copyright (c) 1987, 1988 Borland International Turbo Link Version 2.0 Copyright (c) 1987, 1988 Borland International Available memory 413700 ------------------------------------------------------- main source C (.c) /* 0001 * Indexed file from keyboard mx_d2.cb */ /* 0002 * */ /* 0003 file-control. */ /* 0004 select IDX assign "mx_d2.dat". */ /* 0005 file section. */ /* 0006 fd IDX. */ /* 0007 1 REC-IDX. */ /* 0008 2 KEY-IDX pic 9(5). */ /* 0009 2 DAT-IDX pic x(25). */ /* 0010 working-storage section. */ /* 0011 1 INP pic x(50) value ".". */ /* 0012 * */ /* 0013 procedure division. */ #include "D:\CeW\cobol\p\mx_d2.d" #undef MXPE #define MXPE(x,y) goto x /* MX COBOL - Jan 08 2000, 16:35:41 */ _l0001: /* @@@ */ /* 0014 call "ICRUN" using "del mx_d2.dat". */ /* CALL */ (void)ICRUN("del mx_d2.dat" ,13L); /* . */ /* 0015 call "ICRUN" using "del mx_d2.in0". */ /* CALL */ (void)ICRUN("del mx_d2.in0" ,13L); /* . */ /* 0016 * */ /* 0017 open output IDX. */ /* OPEN */ F[0].forg=FORG00; F[0].frecf=0; F[0].fst=NULL; F[0].fn="mx_d2.dat"; F[0].rsz=30; icbfopn(&F[0],2); /* . */ /* 0018 perform until INP = " " */ /* PERFORM */ for(;!(/* 0019 display "input = number - comma - text" */ (icbacmp(W,50L," ",1L) == 0));) { /* 1 */ /* DISPLAY */ /* 0020 accept INP */ fprintf(J0,"input = number - comma - text\n"); /* ACCEPT */ /* 0021 if INP not = " " */ Y=(X=W)+50; while (X #include #include #include "c:\mxc\mxcsdtf.h" #include "c:\mxc\mxcicb.h" static void lojo(jmp_buf); static void lojo(lj1) jmp_buf lj1; {longjmp(lj1,1);} #define XERNF 0x01 extern jmp_buf ps[]; extern short pk[]; static unsigned char flag=0; /* 0x80 = ON SIZE ERROR, 0x40 = READY TRACE */ static short i0,i1; static short exprog=0; extern long xferr; static unsigned char W[56]={'.',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ', ' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ', ' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ', ' '}; static unsigned char W1[8]={0,0,0,0,0,0}; static unsigned char W2[16]={'0','4','/','0','6','/','0','6','0','6',':', '3','0',':','1','3'}; static struct sdtf F[1]; /* tabulky souboru */ static void _(int,char**); #define J0 stdout struct J2 {char j[5];}; #define PK(x) if(pk[x]) lojo(ps[x]) #define FORG00 0 unsigned char icbdisac=0, icbbarvy = 0x07; #define STOPRUN static unsigned char *X,*Y,*Z,*Z1; /* pomocne ukazatele */ static long l0,l1,l2,l3; static double d0,d1,d2,d3; static unsigned char P[33]; /* pracovni pole pro vsechny */ static void _(int,char**); ANONYMUS() {exprog++; _(0,(char **)0L); return 0;} unsigned int _stklen = 6 * 1024; struct sicxh icxh; /**/int main(int argc, char **argv) {icbhe(); _(argc,argv); return 0;} #include "D:\CeW\cobol\p\mx_d2.t" #pragma warn -par static void _(int argc, char **argv) /* toto je preklad PROCEDURE */ { /* konec zdroje .d */ ------------------------------------------------------- 2nd include C (.t) #define MXPE(x,y) return y -------------------------------------------------------------------------- MX COBOL - free compiler - (c) Vlastimil Cevela 2006 --------------------------------------------------------------------------